home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / reserv.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.2 KB  |  71 lines
  1.       subroutine reserv (node1,node2)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine records the fact that the (node1, node2) element of
  5. c the circuit equation coefficient matrix is nonzero.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=flags 3/15/83
  17.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  18.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  19. c spice version 2g.6  sccsid=blank 3/15/83
  20.       common /blank/ value(200000)
  21.       integer nodplc(64)
  22.       complex cvalue(32)
  23.       equivalence (value(1),nodplc(1),cvalue(1))
  24. c
  25.       logical memptr
  26. c
  27.       if (nogo.ne.0) go to 300
  28. c...  test for ground
  29.       if (node1.eq.1) go to 300
  30.       if (node2.eq.1) go to 300
  31. c
  32. c     reserve (node1,node2) in row node1 at col posn node2
  33. c
  34.       loc=node1
  35.    10 locj=loc
  36.       loc=nodplc(jcpt+loc)
  37.       if (loc.eq.0) go to 20
  38.       if (nodplc(jcolno+loc)-node2) 10,300,20
  39.    20 call sizmem(jcpt,isize)
  40.       newloc=isize+1
  41.       nodplc(numoff+node1)=nodplc(numoff+node1)+1
  42.       nodplc(nmoffc+node2)=nodplc(nmoffc+node2)+1
  43.       call extmem(jcpt,1)
  44.       call extmem(jcolno,1)
  45.       nodplc(jcpt+locj)=newloc
  46.       nodplc(jcpt+newloc)=loc
  47.       nodplc(jcolno+newloc)=node2
  48. c
  49. c     reserve (node1,node2) in col node2 at row posn node1
  50. c
  51.       loc=node2
  52.    30 loci=loc
  53.       loc=nodplc(irpt+loc)
  54.       if (loc.eq.0) go to 40
  55.       if (nodplc(irowno+loc)-node1) 30,300,40
  56.    40 call extmem(irpt,1)
  57.       call extmem(irowno,1)
  58.       nodplc(irpt+loci)=newloc
  59.       nodplc(irpt+newloc)=loc
  60.       nodplc(irowno+newloc)=node1
  61. c
  62. c     mark diagonal
  63. c
  64.       if (node1.ne.node2) go to 300
  65.       if (memptr(ndiag)) nodplc(ndiag+node1)=1
  66. c
  67. c     finished
  68. c
  69.   300 return
  70.       end
  71.